home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d5 / pegleap.arc / PEGLEAP.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1986-06-27  |  5.8 KB  |  195 lines
  1. 10  'UPDATE 9/14/82
  2. 20  WIDTH 80:SCREEN 0,0,0:COLOR 3,0:KEY OFF:GOSUB 1610:GOSUB 1930
  3. 30  ON KEY(10) GOSUB 1850
  4. 40  P$="o":H$=" "
  5. 50  DIM B(70),T(9,9)
  6. 60  CLS:XLIN=1:XPOS=1:GOSUB 1900:FOR R=1 TO 9:FOR C=1 TO 9
  7. 70  IF (R-4)*(R-5)*(R-6)=0 THEN 100
  8. 80  IF (C-4)*(C-5)*(C-6)=0 THEN 100
  9. 90  T(R,C)=-5:GOTO 120
  10. 100  IF (R-1)*(C-1)*(R-9)*(C-9)=0 THEN 90
  11. 110  T(R,C)=5:READ XY(R,C)
  12. 120  NEXT C,R:T(5,5)=0
  13. 130  PRINT
  14. 140  PRINT TAB(32)"VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR"
  15. 150  PRINT TAB(32)"CALL o CALL CALL o CALL CALL o CALL"
  16. 160  PRINT TAB(32)"CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND'"
  17. 170  PRINT TAB(32)"VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR"
  18. 180  PRINT TAB(32)"CALL o CALL CALL o CALL CALL o CALL"
  19. 190  PRINT TAB(32)"CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND'"
  20. 200  PRINT TAB(20)"VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR"
  21. 210  PRINT TAB(20)"CALL o CALL CALL o CALL CALL o CALL CALL o CALL CALL o CALL CALL o CALL CALL o CALL"
  22. 220  PRINT TAB(20)"CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND'"
  23. 230  PRINT TAB(20)"VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR"
  24. 240  PRINT TAB(20)"CALL o CALL CALL o CALL CALL o CALL CALL   CALL CALL o CALL CALL o CALL CALL o CALL"
  25. 250  PRINT TAB(20)"CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND'"
  26. 260  PRINT TAB(20)"VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR"
  27. 270  PRINT TAB(20)"CALL o CALL CALL o CALL CALL o CALL CALL o CALL CALL o CALL CALL o CALL CALL o CALL"
  28. 280  PRINT TAB(20)"CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND'"
  29. 290  PRINT TAB(32)"VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR"
  30. 300  PRINT TAB(32)"CALL o CALL CALL o CALL CALL o CALL"
  31. 310  PRINT TAB(32)"CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND'"
  32. 320  PRINT TAB(32)"VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR VARPTRSOUNDSOUNDSOUNDCOLOR"
  33. 330  PRINT TAB(32)"CALL o CALL CALL o CALL CALL o CALL"
  34. 340  PRINT TAB(32)"CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND' CLSSOUNDSOUNDSOUND'"
  35. 350  RESTORE:FOR W=1 TO 33:READ M:B(M)=-7:NEXT:B(41)=-3
  36. 360  DATA 13,14,15,22,23,24,29,30,31,32,33,34,35,38,39,40,41
  37. 370  DATA 42,43,44,47,48,49,50,51,52,53,58,59,60,67,68,69
  38. 380  YS1=12 :XS1= 40
  39. 390  LOCATE 24,1:PRINT SPC(24);"Position Cursor And Strike Enter.";
  40. 400  LOCATE 23,30,0 :PRINT"  Move Which Piece?   ";
  41. 410  LOCATE YS1,XS1,1
  42. 420  GOTO 680
  43. 430  KEY(11) ON:KEY(12) ON:KEY(13) ON:KEY(14) ON
  44. 440  KEY(11) STOP:KEY(12) STOP:KEY(13) STOP:KEY(14) STOP
  45. 450  ON KEY(11) GOSUB 520
  46. 460  ON KEY(12) GOSUB 560
  47. 470  ON KEY(13) GOSUB 600
  48. 480  ON KEY(14) GOSUB 640
  49. 490  MOVE$=INKEY$:IF MOVE$<>CHR$(13) THEN 430
  50. 500  XS1=POS(0):XC1=(POS(0)-10)/6
  51. 510  YS1=CSRLIN:YC1=(CSRLIN/3)+1:RETURN
  52. 520  IF CSRLIN<6 THEN 550
  53. 530  IF CSRLIN<12 AND (POS(0)<34 OR POS(0)>46) THEN 550
  54. 540  LOCATE CSRLIN-3,POS(0),1
  55. 550  RETURN
  56. 560  IF POS(0)<28 THEN 590
  57. 570  IF (CSRLIN<9 OR CSRLIN>15) AND POS(0)<40 THEN 590
  58. 580  LOCATE CSRLIN,POS(0)-6,1
  59. 590  RETURN
  60. 600  IF POS(0)>52 THEN 630
  61. 610  IF (CSRLIN<9 OR CSRLIN>15) AND POS(0)>40 THEN 630
  62. 620  LOCATE CSRLIN,POS(0)+6,1
  63. 630  RETURN
  64. 640  IF CSRLIN>20 THEN 670
  65. 650  IF CSRLIN>12 AND (POS(0)<34 OR POS(0)>46) THEN 670
  66. 660  LOCATE CSRLIN+3,POS(0),1
  67. 670  RETURN
  68. 680  GOSUB 430
  69. 690  ZYS1=YS1:ZXS1=XS1:ZYC1=YC1:ZXC1=XC1:Z=XY(YC1,XC1)
  70. 700  IF B(Z)=-7 THEN 800
  71. 710  CT$=H$
  72. 720  IF T(ZYC1,ZXC1)=5 THEN CT$=P$
  73. 730  LOCATE ZYS1,ZXS1:PRINT CT$;
  74. 740  CT$=H$
  75. 750  IF T(YC1,XC1)=5 THEN CT$=P$
  76. 760  LOCATE YS1,XS1:PRINT CT$;
  77. 770  LOCATE 20,1:PRINT"Illegal Move, Try Again...";
  78. 780  FOR DD=1 TO 1000:NEXT
  79. 790  LOCATE 20,1:PRINT SPC(27);:LOCATE YS1,XS1:GOTO 380
  80. 800  LOCATE 23,31:PRINT"     To Where?       ";
  81. 810  LOCATE YS1,XS1:COLOR 23,0:PRINT P$;:COLOR 3,0
  82. 820  LOCATE YS1,XS1:GOSUB 430
  83. 830  P=XY(YC1,XC1)
  84. 840  IF B(P)=0 OR B(P)=-7 THEN 710
  85. 850  IF Z=P THEN 380
  86. 860  IF ((Z+P)/2)=INT((Z+P)/2) THEN 870 ELSE 710
  87. 870  IF (ABS(Z-P)-2)*(ABS(Z-P)-18)<>0 THEN 710
  88. 880  GOSUB 1010:GOSUB 890:GOSUB 1200:GOTO 380
  89. 890  CT$=H$
  90. 900  IF T(ZYC1,ZXC1)=5 THEN CT$=P$
  91. 910  LOCATE ZYS1,ZXS1:PRINT CT$;:CT$=H$
  92. 920  IF T(YC1,XC1)=5 THEN CT$=P$
  93. 930  LOCATE YS1,XS1:PRINT CT$;
  94. 940  YO1=ZYC1-YC1:XO1=ZXC1-XC1
  95. 950  IF YO1>0 THEN YO1=(1)
  96. 960  IF XO1>0 THEN XO1=(1)
  97. 970  IF YO1<0 THEN YO1=(-1)
  98. 980  IF XO1<0 THEN XO1=(-1)
  99. 990  CT$=H$
  100. 1000  LOCATE YS1+(YO1*3),XS1+(XO1*6):PRINT CT$;:RETURN
  101. 1010  C=1:FOR X=1 TO 9:FOR Y=1 TO 9
  102. 1020  IF C<>Z THEN 1180
  103. 1030  IF C+2<>P THEN 1070
  104. 1040  IF T(X,Y+1)=0 THEN 710
  105. 1050  T(X,Y+2)=5
  106. 1060  T(X,Y+1)=0:B(C+1)=-3:GOTO 1160
  107. 1070  IF C+18<>P THEN 1100
  108. 1080  IF T(X+1,Y)=0 THEN 710
  109. 1090  T(X+2,Y)=5:T(X+1,Y)=0:B(C+9)=-3:GOTO 1160
  110. 1100  IF C-2<>P THEN 1130
  111. 1110  IF T(X,Y-1)=0 THEN 710
  112. 1120  T(X,Y-2)=5:T(X,Y-1)=0:B(C-1)=-3:GOTO 1160
  113. 1130  IF C-18<>P THEN 1180
  114. 1140  IF T(X-1,Y)=0 THEN 710
  115. 1150  T(X-2,Y)=5:T(X-1,Y)=0:B(C-9)=-3:B(Z)=-3:B(P)=-7
  116. 1160  B(Z)=-3:B(P)=-7
  117. 1170  T(X,Y)=0:RETURN
  118. 1180  C=C+1
  119. 1190  NEXT Y,X:RETURN
  120. 1200  F=0
  121. 1210  FOR R=2 TO 8:FOR C=2 TO 8
  122. 1220  IF T(R,C)<>5 THEN 1320
  123. 1230  F=F+1
  124. 1240  FOR A=R-1 TO R+1:T=0:FOR B=C-1 TO C+1:T=T+T(A,B):NEXT B
  125. 1250  IF T<>10 THEN 1270
  126. 1260  IF T(A,C)<>0 THEN 1590
  127. 1270  NEXT A
  128. 1280  FOR X=C-1 TO C+1:T=0:FOR Y=R-1 TO R+1:T=T+T(Y,X):NEXT Y
  129. 1290  IF T<>10 THEN 1310
  130. 1300  IF T(R,X)<>0 THEN 1590
  131. 1310  NEXT X
  132. 1320  NEXT C
  133. 1330  NEXT R
  134. 1340  LOCATE 22,1:PRINT"Only"F"Pieces Remaining."
  135. 1350  LOCATE 24,1:PRINT SPC(79);
  136. 1360  IF F<>1 THEN 1400
  137. 1370  LOCATE 21,1:PRINT"BRAVO!"
  138. 1380  LOCATE 23,1:PRINT"A Perfect Score!"
  139. 1390  IF T(5,5)=5 THEN LOCATE 23,1:PRINT"In The Center! You're A Genius!"
  140. 1400  IF F<>2 THEN 1430
  141. 1410  LOCATE 21,1:PRINT"EXCELLENT!"
  142. 1420  LOCATE 23,1:PRINT"Try Again."
  143. 1430  IF F=3 OR F=4 THEN LOCATE 21,1:PRINT"GREAT!"
  144. 1440  IF F=3 OR F=4 THEN LOCATE 23,1:PRINT"Don't Give Up Yet."
  145. 1450  IF F>=5 AND F<=7 THEN LOCATE 21,1:PRINT"NOT BAD."
  146. 1460  IF F>=5 AND F<=7 THEN LOCATE 23,1:PRINT"Give It Another Shot."
  147. 1470  IF F<8 THEN 1540
  148. 1480  IF F>24 THEN 1520
  149. 1490  LOCATE 21,1:PRINT"OUCH!"
  150. 1500  LOCATE 22,1:PRINT"You Had"F"Pieces Remaining."
  151. 1510  LOCATE 23,1:PRINT"Today Is Not Your Day!":GOTO 1540
  152. 1520  LOCATE 21,1:PRINT"WRONG OBJECTIVE!"
  153. 1530  LOCATE 23,1:PRINT"When All Else Fails, Read The Instructions!"
  154. 1540  LOCATE 24,1,1:PRINT"Would You Like To Play Again? <Y/N>";
  155. 1550  A$=INKEY$:IF A$="" THEN 1550
  156. 1560  IF A$="n" OR A$="N" THEN 1600
  157. 1570  IF A$<>"y" AND A$<>"Y" THEN 1550
  158. 1580  RESTORE:GOTO 60
  159. 1590  RETURN
  160. 1600  RUN "menu
  161. 1610  CLS:COLOR 6,0
  162. 1620  LOCATE 1,1:PRINT STRING$(80,219)
  163. 1630  FOR A=2 TO 22:LOCATE A,1:PRINT"CSRLIN":LOCATE A,80:PRINT"CSRLIN":NEXT
  164. 1640  LOCATE 23,1:PRINT STRING$(80,219);
  165. 1650  LOCATE 3,34:COLOR 11,0:PRINT"P E G    L E A P
  166. 1660  COLOR 15,0:LOCATE 8,25:PRINT"Would You Like Instructions? <Y/N>":COLOR 3
  167. 1670  Z$=INKEY$:IF Z$="" THEN 1670
  168. 1680  IF Z$="N" OR Z$="n" THEN CLS:RETURN
  169. 1690  IF Z$<>"Y" AND Z$<>"y" THEN 1670
  170. 1700  LOCATE 5,10:PRINT"
  171. 1710  LOCATE 7,21:PRINT  "  This is a  simple  little game that is
  172. 1720  LOCATE 8,21:PRINT  "  played a lot like checkers. The object
  173. 1730  LOCATE 9,21:PRINT  "  of the game is to remove as many `pegs'
  174. 1740  LOCATE 10,21:PRINT"  as possible by jumping each `peg' with
  175. 1750  LOCATE 11,21:PRINT"  another.  You may not jump  diagonally.
  176. 1760  LOCATE 12,21:PRINT"  The peg that you jump will be  removed
  177. 1770  LOCATE 13,21:PRINT"  from the game board automatically.
  178. 1780  LOCATE 16,21:PRINT"  First,  position the  cursor under the
  179. 1790  LOCATE 17,21:PRINT"  jumping peg and Strike The  Enter  Key.
  180. 1800  LOCATE 18,21:PRINT"  Then,  move  the  cursor  to the empty
  181. 1810  LOCATE 19,21:PRINT"  hole that you are jumping to and again
  182. 1820  LOCATE 20,21:PRINT"  Strike The Enter Key.
  183. 1830  LOCATE 25,28:COLOR 15,0:PRINT"Strike Any Key To Continue";
  184. 1840  Z$=INKEY$:IF Z$="" THEN 1840 ELSE CLS:RETURN
  185. 1850  KEY(10) OFF:XLIN=CSRLIN:XPOS=POS(0):LOCATE 25,1:PRINT SPC(79);
  186. 1860  LOCATE 25,22:PRINT"Do You Wish To Leave This Game? <Y/N>";
  187. 1870  Z$=INKEY$:IF Z$="" THEN 1870
  188. 1880  IF Z$="y" OR Z$="Y" THEN RUN"menu
  189. 1890  IF Z$<>"n" AND Z$<>"N" THEN 1870
  190. 1900  LOCATE 25,1:PRINT SPC(79);:LOCATE 25,25:COLOR 0,7
  191. 1910  PRINT" Strike <F10> To Leave This Game ";:COLOR 3,0:LOCATE XLIN,XPOS,0
  192. 1920  KEY(10) ON:RETURN
  193. 1930  FOR A=1 TO 9:ON KEY(A) GOSUB 1940:KEY(A) ON:NEXT
  194. 1940  RETURN
  195.